home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Eagles Nest BBS 8
/
Eagles_Nest_Mac_Collection_Disc_8.TOAST
/
Developer Tools⁄Additions
/
InsideBa1994
/
InsideBasic-94
/
IB 94
/
Simple DB
/
PG PRO.INCL
< prev
next >
Wrap
Text File
|
1993-10-23
|
87KB
|
1,789 lines
'===============================================================================
'= Copyright 1992 Staz™ Software, Inc. =
'= All rights reserved / "PG PRO.INCL" from PG:PRO II =
'===============================================================================
INCLUDE FILE _aplIncl
COMPILE 0,_MacsbugLabels_strResource_caseInsensitive'set by PG:PRO
GLOBALS "PG PRO.GLBL" 'include standard global file
END GLOBALS 'no other globals
DEFSTR LONG
GOTO "PG:Start"
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ ALERTS/DIALOGS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
'_______________________________________________________________________________
LOCAL FN pGcntrRes(type&,resID) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM t,l,b,r 'local rect
CURSOR _arrowCursor 'reset arrow cursor
hndl& = FN GETRESOURCE(type&,resID) 'handle to alert resource
LONG IF hndl& 'got a handle?
t;8 = [hndl&] 'copy alert's rect
CALL OFFSETRECT(t,-l,-t) 'center it
CALL OFFSETRECT(t,gScrnR/2-r/2,{_mBarHeight}+gScrnB/3-b/3)
BLOCKMOVE @t,[hndl&],8 'modify the resource
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGshowErr(errorNum) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM pTxt$(3) 'holds message strings
'## Description ---------- ## Description ---------- ## Description ----------
'01 Add/Chg res failed 05 couldn't save pG3c res 09 used pGbuild(0)
'02 couldn't get pG3w res 06 name of PG PRO app 10 used pGclose(0)
'03 couldn't save pG3w res 07 paste too big for fld 11 your codes start here
'04 couldn't get pG3c res 08 too many chars in fld 00 You CALL PARAMTEXT!
'## Description ---------- ## Description ---------- ## Description ----------
FN pGcntrRes(_"ALRT",_baseID-1) 'center the error alert window
LONG IF errorNum
pTxt$(1) = STR#(_baseID-1,errorNum) 'error message from STR#
pTxt$(2) = MID$(STR$(errorNum),2) 'error number from entry param
pTxt$(3) = STR#(_baseID-1,6) 'error message from STR#
CALL PARAMTEXT(pTxt$(1),pTxt$(2),pTxt$(3),"")'set up text for alert
END IF
x = FN ALERT(_baseID-1,0) 'show the alert
END FN
'_______________________________________________________________________________
LOCAL FN pGgetText$(theDialog&,theItem) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM t;8 'local DIMs
CALL GETDITEM(theDialog&,theItem,itemType,itemHandle&,t)
CALL GETITEXT(itemHandle&,theText$) 'get the text
END FN = theText$ 'return simple string
'_______________________________________________________________________________
LOCAL FN pGsetText(theDialog&,theItem,theText$) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM t;8 'local DIMs/get this item
CALL GETDITEM(theDialog&,theItem,itemType,itemHandle&,t)
CALL SETITEXT(itemHandle&,theText$) 'get the text
CALL SELITEXT(theDialog&,theItem,0,[itemHandle&]+_TELength)
END FN
'_______________________________________________________________________________
LOCAL FN pGframeBtn(theDialog&,theItem) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
CALL SETPORT(theDialog&) 'allow drwg before MODALDIALOG
DIM t;8 'local DIMs/get this item
CALL GETDITEM(theDialog&,theItem,itemType,itemHandle&,t)
CALL INSETRECT(t,-4,-4) 'expand rect
CALL PENNORMAL:PEN 3,3 '3x3 pen
LONG IF PEEK([itemHandle&]+_contrlHilite)=255 'btn disabled
CALL PENPAT(#REGISTER(A5)-28) 'make it gray
END IF '
CALL FRAMEROUNDRECT(t,16,16) 'frame it
CALL PENNORMAL 'restore pen
END FN
'_______________________________________________________________________________
LOCAL FN pGask$(theQuestion$,theAnswer$) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
theWindow = WINDOW(_activeWnd) 'record current window
CALL GETPORT(oldPort&)
FN pGcntrRes(_"DLOG",_baseID - 2) 'center the dialog
CALL PARAMTEXT(theQuestion$,"","","") 'show the prompt
theDialog& = FN GETNEWDIALOG(_baseID - 2,0,-1) 'get & disp the resource
FN pGsetText(theDialog&,3,theAnswer$):theAnswer$=""'default answer
FN pGframeBtn(theDialog&,1) 'frame the OK btn
DO 'here we go
CALL MODALDIALOG(0,hitItem) 'cycle till OK/Cancel clicked
UNTIL hitItem < 3 '
LONG IF hitItem = 1 'was it OK?
theAnswer$ = FN pGgetText$(theDialog&,3) 'yes, return the answer
IF theAnswer$="" THEN theAnswer$=" " 'send a space if OK'd null
END IF
CALL DISPOSDIALOG(theDialog&) 'all done
LONG IF theWindow
WINDOW(theWindow) 'restore active window
XELSE
IF oldPort& THEN CALL SETPORT(oldPort&)
END IF
END FN = theAnswer$
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ RESOURCE FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
'_______________________________________________________________________________
LOCAL FN pGreplaceRes(resHndl&,resTp&,resID,resName$)'∑∑œœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
LONG IF resHndl&
hndlFlags = FN HGETSTATE(resHndl&) 'get state of new handle
LONG IF hndlFlags AND _resource% '!! tried to send res hndl!!
OSErr = FN HNOPURGE(resHndl&) 'don't allow purge during copy
newHndl& = FN HANDTOHAND(resHndl&) 'duplicate the handle
OSErr = FN HSETSTATE(resHndl&,hndlFlags) 'restore orig state
resHndl& = newHndl& 'now use the new hndl
END IF
END IF
LONG IF resHndl&
curRes = FN CURRESFILE 'record current res reference
CALL USERESFILE(gResRef) 'use output file
oldRes& = FN GET1RESOURCE(resTp&,resID) 'check for existing res
LONG IF oldRes& 'got one?
hndlFlags = FN HGETSTATE(oldRes&) 'save current handle info
OSErr = FN HUNLOCK(oldRes&) 'unlock it
OSErr = FN HNOPURGE(oldRes&) 'don't allow purge
theSize& = FN GETHANDLESIZE(resHndl&) 'get new size
OSErr = FN SETHANDLESIZE(oldRes&,theSize&) 'resize old to match
BLOCKMOVE [resHndl&],[oldRes&],theSize& 'replace old data
OSErr = FN HSETSTATE(oldRes&,hndlFlags) 'restore handle info
OSErr = FN HNOPURGE(oldRes&) 'don't allow purge
CALL CHANGEDRESOURCE(oldRes&) 'mark it as changed
OSErr = FN DISPOSHANDLE(resHndl&) 'dump the duplicate hndl
LONG IF LEN(resName$)
CALL SETRESINFO(oldRes&,resID,resName$)
END IF
XELSE 'otherwise, just add it
CALL ADDRESOURCE(resHndl&,resTp&,resID,resName$)'add it
CALL SETRESATTRS(resHndl&,_resPurgeable%) 'make it purgable
CALL CHANGEDRESOURCE(resHndl&) 'mark change(after SETRESATTRS)
OSErr = _noERR
END IF '
CALL USERESFILE(curRes) 'restore orig file
LONG IF FN RESERROR OR OSErr 'any problems?
FN pGshowErr(1) 'my error code for failure
END IF
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGreplaceXRes(resHndl&,resTp&,resID,resName$,resRef)'∑∑œœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
oldRes = gResRef 'record old res file ref
gResRef = resRef 'temp switch to new
FN pGreplaceRes(resHndl&,resTp&,resID,resName$)'save res in new file
gResRef = oldRes 'switch back to orig file
END FN
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ OBJECT FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
'_______________________________________________________________________________
LOCAL FN pGcountObj(objListID) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
resHndl& = FN GETRESOURCE(_"pG3c",objListID) 'handle to wnd cntrl resource
LONG IF resHndl& 'valid handle?
objCount = {[resHndl&]} 'obj count is first word of res
XELSE 'no handle?
FN pGshowErr(4) 'tell user something's wrong
objCount = 0 'send back zero count
END IF '
END FN = objCount 'FN result is num of elements
'_______________________________________________________________________________
LOCAL FN pGgetObj(objListID,objElem) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
resHndl& = FN GETRESOURCE(_"pG3c",objListID) 'handle to wnd cntrl resource
LONG IF resHndl& 'valid handle?
DEC(objElem) 'allow for OCNT
offSet& = 2 + objElem * _objRecSz 'calc offset to correct element
gObject = [resHndl&]+offSet& 'blkmove to global record
XELSE 'no handle?
FN pGshowErr(4) 'tell user something's wrong
END IF '
END FN
'_______________________________________________________________________________
LOCAL FN pGputObj(objListID,objElem) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
resHndl& = FN GETRESOURCE(_"pG3c",objListID) 'handle to wnd cntrl resource
LONG IF resHndl& 'valid handle?
OSErr = FN HNOPURGE(resHndl&)
DEC(objElem) 'allow for OCNT
offSet& = 2 + objElem * _objRecSz 'calc offset to correct element
BLOCKMOVE @gObjSel,[resHndl&]+offSet&,_objRecSz'blkmove to resource
CALL CHANGEDRESOURCE(resHndl&) 'mark it as changed
XELSE 'no handle?
FN pGshowErr(5) 'tell user something's wrong
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGgetRef(objListID,theRef) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
theCount = FN pGcountObj(objListID) 'number of objects
element = 0 'element not yet found
LONG IF theCount 'non-zero count?
FOR loop = 1 TO theCount 'loop thru object list
FN pGgetObj(objListID,loop) 'get this object
LONG IF gObjKind <> _graphicObj 'ref not valid on graphics
LONG IF ABS(gObjRef) = ABS(theRef) 'matches reference?
element = loop 'record element
loop = theCount 'shortcut the loop
END IF '
END IF
NEXT
END IF '
END FN = element 'global record filled on return
'_______________________________________________________________________________
LOCAL FN pGpointInObj '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM t;8
theObject = 0
objCount = FN pGcountObj(gWhichClass) 'get num of objs in list
LONG IF objCount 'non zero?
resHndl& = FN GETRESOURCE(_"pG3c",gWhichClass)
FOR loop = objCount-1 TO 0 STEP - 1 'loop thru backwards
offSet& = 2 + loop * _objRecSz
t;8 = [resHndl&] + offSet& + 6
LONG IF FN PTINRECT(gMouseY,t) 'clicked here?
theObject = loop + 1 'set return value to this obj
loop = 0 'jump the loop
END IF
NEXT
END IF
END FN = theObject
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ DRAWING FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
'_______________________________________________________________________________
LOCAL FN pGdepthOfPoint(my,mx) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
inColor = _false
LONG IF SYSTEM(_macPlus) = _false
CALL LOCALTOGLOBAL(my)
gdHndl& = FN GETDEVICELIST
WHILE gdHndl&
LONG IF FN PTINRECT(my,#[gdHndl&]+_gdRect)
IF {[[[gdHndl&]+_gdpMap]]+_pmPixelSize} > 2 THEN inColor = _zTrue
gdHndl& = 0
END IF
IF gdHndl& THEN gdHndl& = FN GETNEXTDEVICE(gdHndl&)
WEND
END IF
END FN = inColor
'_______________________________________________________________________________
CLEAR LOCAL
LOCAL FN pGblackAndWhite '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM RECORD aWndRec 'auxiliary window rec
DIM setCPat ,aWndCPatID
DIM setBWPat ,aWndBWPatID
DIM setRGB ,aWndRGBrec;6
DIM aWndType&,aWndRefCon&
DIM setFont ,aWndFSize,aWndFMode,aWndFFace
DIM setSpare ,aWndData;40,aWndDCODID
DIM aWndRsrv1&,aWndRsrv2&
DIM 60 aWndFontName$
DIM END RECORD _aWndSz
CALL PENNORMAL 'fix pen
CALL FORECOLOR(33)
CALL BACKCOLOR(30)
resHndl& = FN GETRESOURCE(_"pG3*",gWhichClass)
LONG IF resHndl&
BLOCKMOVE [resHndl&],@aWndRec,_aWndSz
inColor = FN pGdepthOfPoint(WINDOW(3)/2,WINDOW(2)/2)
LONG IF inColor 'not black & white?
LONG IF setCPat
ppat& = FN GETPIXPAT(aWndCPatID)
LONG IF ppat&
CALL BACKPIXPAT(ppat&)
END IF
END IF
LONG IF setRGB
CALL RGBBACKCOLOR(aWndRGBrec)
END IF
XELSE 'black & white
LONG IF setBWPat
pat& = FN GETPATTERN(aWndBWPatID)
` BEQ.S noPat
` MOVE.L D0,A0
` MOVE.L (A0),-(SP)
` _backPat
`noPat
END IF
END IF
LONG IF setFont 'default font
LONG IF WINDOW(_outputWnd)
CALL GETFNUM(aWndFontName$,fNum)
TEXT fNum,aWndFSize,aWndFFace,aWndFMode-1
END IF
END IF
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGuseObjColor '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
LONG IF gScreenDepth > 1 'not black & white?
CALL RGBFORECOLOR(gObjFRed) 'use object's forecolor
CALL RGBBACKCOLOR(gObjBRed) 'use object's backcolor
END IF
END FN
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ CONTROL FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
'_______________________________________________________________________________
LOCAL FN pGfixEditor '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM t,l,b,r
LONG IF WINDOW(_EFnum) = 8001 'is this a Text Editor?
FN pGgetRef(WINDOW(_outputWClass),8001)
LONG IF gObjAutoReSz
t;8 = WINDOW(_wndPointer)+_portRect 'get window's rect
r=r-15:b=b-17 'inset for scroll bars
LONG IF BUTTON&(8000)
wd = {[PRHANDLE] + _prInfo + _rPage + _right}
SCROLL BUTTON 8000,,,wd,wd/5
TEHndl& = TEHANDLE(8001)
LONG IF TEHndl&
BLOCKMOVE @t,[TEHndl&]+8,8
oldR = r
r = l + wd + 34
CALL OFFSETRECT(t,-BUTTON(8000)+_TEWndInset,0)
BLOCKMOVE @t,[TEHndl&],8
r = oldR
CALL TECALTEXT(TEHndl&)
CALL TEUPDATE(t,TEHndl&)
END IF
XELSE
CALL INSETRECT(t,_TEWndInset,_TEWndInset)
EDIT FIELD 8001,,@t
END IF
LONG IF BUTTON&(8001) 'vert scroll present?
rowCnt = ((b-t) >> 4) - 2 'calc an avg row count
SCROLL BUTTON 8001,,,,rowCnt 'reset pg up/down
END IF
END IF
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGdrawControls '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
theCount = FN pGcountObj(gWhichClass) 'count objects in window
cBackPat = FN pGblackAndWhite
firstFld = 0
LONG IF theCount 'non-zero?
'
FOR loop = 1 TO theCount 'fields before scroll bars
FN pGgetObj(gWhichClass,loop) 'get next object
LONG IF gObjKind = _pictObj 'it's a pict field
LONG IF gObjResID 'picture included?
PICTURE FIELD gObjRef,%gObjResID,@gObjT,gObjZType,gObjZJust
XELSE 'no picture
PICTURE FIELD gObjRef,"",@gObjT,gObjZType,gObjZJust
END IF
END IF 'end of pict obj
LONG IF gObjKind = _styleObj 'styled text field?
gObjZJust = gObjZJust + (gObjFRed<<2)
LONG IF gObjResID 'existing text?
resHndl& = FN GETRESOURCE(_"pG3t",gObjResID)
LONG IF resHndl&
EDIT FIELD -gObjRef,&resHndl&,(gObjL,gObjT)-(gObjR,gObjB),gObjZType,gObjZJust
END IF
XELSE 'build it blank
EDIT FIELD -gObjRef,"",@gObjT,gObjZType,gObjZJust
END IF 'NOTE: fields built 1st to allow
LONG IF firstFld = 0
LONG IF ((gObjZType-1) AND &X1100)=0 'not a static or gray field
LONG IF gObjRef < 8000
firstFld = gObjRef
END IF
END IF
END IF 'attachment to scroll bars
LONG IF firstFld = 0
LONG IF ((gObjZType-1) AND &X1100)=0 'not a static or gray field
LONG IF gObjRef < 8000
firstFld = gObjRef
END IF
END IF
END IF
END IF 'end of _styleObj
NEXT
'
FOR loop = 1 TO theCount 'scroll bars before lists
FN pGgetObj(gWhichClass,loop) 'get next object
LONG IF gObjKind = _scrollObj 'scroll bar?
LONG IF ABS(gObjSel) <>1 'part of a group?
group = gObjSel 'record current group
attachedRef = 0
FOR stylLoop = 1 TO theCount 'loop thru obj list
LONG IF stylLoop <> loop 'not the same object
FN pGgetObj(gWhichClass,stylLoop) 'get obj record
LONG IF group = gObjSel 'part of same group?
LONG IF gObjKind = _styleObj 'styled field?
attachedRef = -gObjRef 'attach button to style field
stylLoop = theCount 'short cut rest of the loop
END IF
END IF
END IF
NEXT
FN pGgetObj(gWhichClass,loop) 'reload old record
LONG IF attachedRef 'was there a matching field?
gObjRef = attachedRef 'yes, change this reference
END IF
END IF
SCROLL BUTTON gObjRef,gObjCtrlVal,gObjMin,gObjMax,gObjPgUpDn,@gObjT,gObjZType
END IF 'attachment to scroll bars
NEXT
'
FOR loop = 1 TO theCount 'loop thru list
FN pGgetObj(gWhichClass,loop) 'get next object
SELECT gObjKind 'what kind is it?
CASE _styleObj,_pictObj 'fields already built
CASE _scrollObj 'scroll bars already built
CASE _buttonObj 'it's a button
LONG IF gObjZType
objText$ = STR#(_baseID,gObjElement)
BUTTON gObjRef,gObjCtrlVal,objText$,@gObjT,gObjZType
XELSE
gSubAction = _otherUserInit 'set flag to init obj
gWhichObjElem = loop
oldWClass = gWhichClass
GLOBALS GOSUB "PG:Any Other"
gWhichClass = oldWClass
FN pGblackAndWhite 'user may have chgd bkgnd
END IF
CASE _listObj 'it's a scrolling list
resHndl& = FN GETRESOURCE(_"STR#",gObjResID)
LONG IF resHndl&
CALL GETRESINFO(resHndl&,ID,tp&,objText$)
TEXT gObjLFont,gObjLSize,0,0
SWAP gObjFBlue,gObjBlue
IF gScreenDepth > 1 THEN CALL RGBFORECOLOR(gObjFRed)
SWAP gObjFBlue,gObjBlue
BUTTON gObjRef,gObjResID,objText$,@gObjT,gObjZType
END IF
END SELECT
NEXT 'next object
END IF
LONG IF firstFld 'got an active field
EDIT FIELD firstFld 'activate it
SETSELECT 0,WINDOW(_EFTextLen) 'select all its text
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGsetGroup(theRef) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
selectedBtn = 0 'default result = none
element = FN pGgetRef(gWhichClass,theRef) 'get the referenced element
LONG IF element 'got it?
LONG IF gObjKind = _buttonObj 'is it a button?
LONG IF ABS(gObjSel) > 1 'part of a group?
LONG IF gObjZType = 3 'a radio button?
theGroup = gObjSel 'this is the group we need
theCount = FN pGcountObj(gWhichClass) 'number of objects
FOR loop = 1 TO theCount 'loop thru list
FN pGgetObj(gWhichClass,loop) 'get this obj
LONG IF gObjSel = theGroup 'right group?
LONG IF gObjKind = _buttonObj 'is it a button?
LONG IF gObjZType = 3 'a radio button?
LONG IF gObjRef = theRef 'set this one?
BUTTON gObjRef,2
XELSE
LONG IF BUTTON(gObjRef) = 2 'don't mess with disabled btns
BUTTON gObjRef,1
END IF
END IF
END IF
END IF
END IF
NEXT loop
END IF
END IF
END IF
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGgetGroup(theRef) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
selectedBtn = 0 'default result = none
element = FN pGgetRef(gWhichClass,theRef) 'get the referenced element
LONG IF element 'got it?
LONG IF gObjKind = _buttonObj 'is it a button?
LONG IF ABS(gObjSel) > 1 'part of a group?
LONG IF gObjZType = 3 'a radio button?
theGroup = gObjSel 'this is the group we need
theCount = FN pGcountObj(gWhichClass) 'number of objects
FOR loop = 1 TO theCount 'loop thru list
FN pGgetObj(gWhichClass,loop) 'get this obj
LONG IF gObjSel = theGroup 'right group?
LONG IF gObjKind = _buttonObj 'is it a button?
LONG IF gObjZType = 3 'a radio button?
LONG IF BUTTON(gObjRef) = 2 'is it set?
selectedBtn = gObjRef 'gotcha
loop = theCount 'skip the rest of the loop
END IF
END IF
END IF
END IF
NEXT loop
END IF
END IF
END IF
END IF
END FN = selectedBtn
'_______________________________________________________________________________
LOCAL FN pGbtnAction(theRef) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM t,l,b,r
gDblClick = _false
LONG IF theRef = 8000
FN pGfixEditor
XELSE
element = FN pGgetRef(gWhichClass,theRef) 'get btn's obj record
LONG IF element 'found the record?
SELECT gObjKind
CASE _scrollObj 'a scroll button?
t;8 = @gObjT 'record it's rect
theGroup = gObjSel
LONG IF ABS(theGroup)>1
theCount = FN pGcountObj(gWhichClass)'number of objects
FOR loop = 1 TO theCount 'loop thru list
FN pGgetObj(gWhichClass,loop) 'get this obj
LONG IF gObjSel = theGroup
LONG IF gObjKind = _listObj 'scrolling list?
LONG IF gObjT=t AND gObjR=l+1 'next to this scroll bar?
LONG IF BUTTON&(gObjRef)
LONG IF {[[[BUTTON&(gObjRef)]+_contrlData]]} <> BUTTON(theRef)-1
%[[[BUTTON&(gObjRef)]+_contrlData]],BUTTON(theRef)-1
INC(gObjB):CALL CLIPRECT(gObjT)'add to clip & redraw
CALL DRAW1CONTROL(BUTTON&(gObjRef))
BUTTON gObjRef,BUTTON(gObjRef)'restores autoclip
END IF
END IF
loop = theCount 'shortcut the loop
END IF
END IF
END IF
NEXT
END IF
CASE _buttonObj 'regular button?
SELECT gObjZType 'what type?
CASE 2 'check box?
LONG IF BUTTON(gObjRef) = 2 'if it was selected
BUTTON gObjRef,1 'deselect it
XELSE 'otherwise
BUTTON gObjRef,2 'select it
END IF
CASE 3 'radio button?
LONG IF ABS(gObjSel) <> 1 'should be part of a group
theGroup = gObjSel 'record group number
theCount = FN pGcountObj(gWhichClass)'number of objects
FOR loop = 1 TO theCount 'loop thru list
FN pGgetObj(gWhichClass,loop) 'get this obj
LONG IF gObjSel = theGroup 'same group?
LONG IF BUTTON(gObjRef) 'only toggle active buttons
LONG IF gObjRef = theRef 'clicked button?
BUTTON gObjRef,2 'yes, select it
XELSE 'no
BUTTON gObjRef,1 'deselect it
END IF
END IF
END IF
NEXT
END IF
END SELECT
CASE _listObj
LONG IF FN TICKCOUNT <= gDblTime&
LONG IF gDblRef = theRef
LONG IF gDblWnd = gActiveWnd
gDblClick = _zTrue
END IF
END IF
END IF
LONG IF gDblClick = _false
IF _ignoreSnglClk THEN gAction = 0
gDblRef = theRef
gDblTime& = FN TICKCOUNT + [_doubleTime]
gDblWnd = gActiveWnd
XELSE
gDblWnd = 0
END IF
END SELECT
END IF
END IF
FN pGblackAndWhite
END FN
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ WINDOW FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
'_______________________________________________________________________________
LOCAL FN pGgetWnd$(resID,recordPtr&) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
resHndl& = FN GETRESOURCE(_"pG3w",resID)
LONG IF resHndl&
BLOCKMOVE [resHndl&],recordPtr&,FN GETHANDLESIZE(resHndl&)
CALL GETRESINFO(resHndl&,resID,tp&,wTitle$)
XELSE
FN pGshowErr(2)
wTitle$ = "ERROR"
END IF
END FN = wTitle$
'_______________________________________________________________________________
LOCAL FN pGputWnd(resID,recordPtr&) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
resHndl& = FN GETRESOURCE(_"pG3w",resID)
LONG IF resHndl&
OSErr = FN HNOPURGE(resHndl&)
LONG IF FN GETHANDLESIZE(resHndl&) >0
BLOCKMOVE recordPtr&,[resHndl&],FN GETHANDLESIZE(resHndl&)
CALL CHANGEDRESOURCE(resHndl&)
END IF
XELSE
FN pGshowErr(3)
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGcalcWndGlobals '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
gActWindow = WINDOW(_activeWnd)
gOutWindow = WINDOW(_outputWnd)
gWhichClass = WINDOW(_outputWClass)
END FN
'_______________________________________________________________________________
LOCAL '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
DIM t;8
LOCAL FN pGinsetWnd(t;8,theWndType,rectPtr&) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
SELECT theWndType 'what type of window is this?
CASE 3,4 :CALL INSETRECT (t, 8, 8) 'plain or shadow (8 pix border)
CASE 2 :CALL INSETRECT (t,12,12) 'modal dialog(8 pix gray+4 pix)
CASE ELSE:CALL INSETRECT (t, 8, 8):t = t + 16'window with title bar
END SELECT 'done
BLOCKMOVE @t,rectPtr&,8
END FN 'return with rect's addr
'_______________________________________________________________________________
LOCAL FN pGsetGrow '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM pGwT,pGwL,pGwB,pGwR,pGwKind,pGwAttrs,pGwMinX,pGwMinY
DIM pGwMaxX,pGwMaxY,pGZmT,pGZmL,pGZmB,pGZmR
DIM pGwHpg,pGwHMax,pGwVpg,pGwVMax,pGwRefCon&
wTitle$ = FN pGgetWnd$(gWhichClass,@pGwT)
IF pGwMinX < 50 THEN pGwMinX = 50
IF pGwMinY < 50 THEN pGwMinY = 50
IF pGwMaxX < pGwMinX THEN pGwMaxX = 1000
IF pGwMaxY < pGwMinY THEN pGwMaxY = 1000
MINWINDOW pGwMinX,pGwMinY
MAXWINDOW pGwMaxX,pGwMaxY
END FN
'_______________________________________________________________________________
LOCAL FN pGsetZoom '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM t,l,b,r,centerY,centerX
DIM pGwT,pGwL,pGwB,pGwR,pGwKind,pGwAttrs,pGwMinX,pGwMinY
DIM pGwMaxX,pGwMaxY,pGZmT,pGZmL,pGZmB,pGZmR
DIM pGwHpg,pGwHMax,pGwVpg,pGwVMax,pGwRefCon&
wTitle$ = FN pGgetWnd$(gWhichClass,@pGwT)
LONG IF [@pGZmB] 'custom zoom size
t;8 = @pGZmT
XELSE
t;8 = @gScrnT 'just copy the main scrn
centerY = WINDOW(_height)>>1
centerX = WINDOW(_width) >>1
CALL LOCALTOGLOBAL(centerY)
LONG IF SYSTEM(3) = 0 'newer than a Mac plus
gdHndl& =FN GETDEVICELIST 'handle to 1st device in list
DO
t;8 = [gdHndl&]+_gdRect 'get its rect
LONG IF FN PTINRECT(centerY,t) 'cntr of wnd in this monitor?
gdHndl& = 0
XELSE
gdHndl& = FN GETNEXTDEVICE(gdHndl&) 'get next scrn
END IF 'end of not main scrn
UNTIL gdHndl& = 0
END IF 'end of not a max plus
t = t + {_mBarHeight} 'allow for the menu bar
FN pGinsetWnd(@t,_docZoom,@t) 'inset wnd as per window kind
END IF
SETZOOM gWhichWindow,@t
END FN
'_______________________________________________________________________________
LOCAL FN pGupdate '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
theCount = FN pGcountObj(WINDOW(_outputWClass))
LONG IF theCount
FOR loop = 1 TO theCount
FN pGgetObj(WINDOW(_outputWClass),loop)
LONG IF gObjKind = _graphicObj
FN pGuseObjColor 'set to this color
LONG IF gObjZType 'not a line
LONG IF gObjFillPat > -1 'shape is filled
PEN 1,1,1,_patCopy,gObjFillPat 'set fill pat
SELECT gObjZType
CASE 4:CALL PAINTRECT(gObjT) 'filled box
CASE 5:CALL PAINTROUNDRECT(gObjT,16,16)'filled rnd rect
CASE 6:CALL PAINTOVAL(gObjT) 'filled oval
END SELECT
END IF
PEN gObjRef,gObjRef,1,_patCopy,gObjLinePat
SELECT gObjZType
CASE 1,4:CALL FRAMERECT(gObjT) 'box
CASE 2,5:CALL FRAMEROUNDRECT(gObjT,16,16)'rnd rect
CASE 3,6:CALL FRAMEOVAL(gObjT) 'oval
END SELECT
XELSE 'it's a line
PEN gObjRef,gObjRef,1,_patCopy,gObjLinePat
CALL MOVETO(gObjL,gObjT)
CALL LINETO(gObjR,gObjB)
END IF
XELSE
LONG IF gObjKind = _buttonObj AND gObjZType = 0
gSubAction = _otherUserUpdate 'set flag to draw obj
gWhichObjElem = loop 'record this element num
FN pGcalcWndGlobals
GLOBALS GOSUB "PG:Any Other" ' manually for GOSUB
END IF
END IF
NEXT
FN pGblackAndWhite
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGgetWTitle(theWindow) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
gWindowTitle$ = ""
LONG IF theWindow
GET WINDOW theWindow ,wPtr&
IF wPtr& THEN CALL GETWTITLE(wPtr&,gWindowTitle$)
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGcloseWindow(wndRefNum) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
: 'see if window exists
LONG IF WINDOW(-wndRefNum) = 0 OR wndRefNum<1 OR wndRefNum>64
FN pGshowErr(10) 'show the error
XELSE
WINDOW OUTPUT wndRefNum
gWhichClass = WINDOW(_outputWClass)
gActWindow = wndRefNum
theCount = FN pGcountObj(gWhichClass)
LONG IF theCount
FOR loop = 1 TO theCount
FN pGgetObj(gWhichClass,loop)
LONG IF gObjKind = _buttonObj
LONG IF gObjZType = 0
gSubAction = _otherUserDispose 'set flag to dispose obj
gWhichObjElem = loop
GLOBALS GOSUB "PG:Any Other"
END IF
END IF
NEXT
END IF
DIM pGwT,pGwL,pGwB,pGwR,pGwKind,pGwAttrs,pGwMinX,pGwMinY
DIM pGwMaxX,pGwMaxY,pGZmT,pGZmL,pGZmB,pGZmR
DIM pGwHpg,pGwHMax,pGwVpg,pGwVMax,pGwRefCon&
wTitle$ = FN pGgetWnd$(gWhichClass,@pGwT)
LONG IF pGwAttrs AND _openPrevMask '€€ Open Previous €€€€€€€€€€€€
pGwT;8 = WINDOW(_wndPointer)+_portRect 'get local rect
CALL LOCALTOGLOBAL(pGwT) 'convert top/left to global
CALL LOCALTOGLOBAL(pGwB) 'convert bot/right to global
FN pGputWnd(gWhichClass,@pGwT) 'save these coords
END IF '
WINDOW CLOSE wndRefNum 'close the window
END IF
FN pGcalcWndGlobals
FN pGgetWTitle(gActWindow)
END FN
'_______________________________________________________________________________
LOCAL FN pGclose(wndRefNum) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
gDialogValue = wndRefNum
GLOBALS GOSUB "PG:WCls"
END FN
'_______________________________________________________________________________
LOCAL FN pGcloseAll '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
OK2Close = _zTrue
WHILE (WINDOW(_activeWnd)<>0) AND (gAction<>0)
gDialogValue = WINDOW(_activeWnd)
GLOBALS GOSUB"PG:WCls"
OK2Close = (gAction <> 0)
WEND
END FN = OK2Close
'_______________________________________________________________________________
LOCAL FN pGbuild(wndRefNum) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM pGwT,pGwL,pGwB,pGwR,pGwKind,pGwAttrs,pGwMinX,pGwMinY
DIM pGwMaxX,pGwMaxY,pGZmT,pGZmL,pGZmB,pGZmR
DIM pGwHpg,pGwHMax,pGwVpg,pGwVMax,pGwRefCon&
'
DIM t,l,b,r 'scratch rect
DIM secndT,secndL,secndB,secndR 'rect of secondary monitor
gWhichClass = ABS(wndRefNum)
LONG IF wndRefNum < 0
FOR loop = 1 TO 64
LONG IF WINDOW(-loop) = 0
LONG IF FN GETRESOURCE(_"pG3w",loop) = 0
wndRefNum = loop
loop = 64
END IF
END IF
NEXT
END IF
LONG IF WINDOW(-wndRefNum) 'already opened?
WINDOW wndRefNum 'bring it forward
XELSE
LONG IF FN GETRESOURCE(_"pG3w",gWhichClass) = 0
FN pGshowErr(9):GOTO"PG:Build Complete"
END IF
wTitle$ = FN pGgetWnd$(gWhichClass,@pGwT) 'get resource
LONG IF wTitle$<>"ERROR" 'got the resource?
LONG IF pGwAttrs AND _openFullMask '€€ Full/Main €€€€€€€€€€€€€€€€
pGwT;8 = @gScrnT 'copy main screen rect
FN pGinsetWnd(@pGwT,pGwKind,@pGwT) 'adjust for title & borders
END IF
LONG IF pGwAttrs AND _openFull2Mask '€€ Full/Secondary €€€€€€€€€€€
LONG IF SYSTEM(3) 'mac plus (no device drvr)
pGwT;8 = @gScrnT 'just copy the main scrn
XELSE 'otherwise
gdHndl& =FN GETDEVICELIST 'handle to 1st device in list
pGwT;8 = [gdHndl&]+_gdRect 'get its rect
LONG IF {[gdHndl&]+_gdflags} AND _mainScreen%'keep going-it's main scrn
gdHndl& = FN GETNEXTDEVICE(gdHndl&) 'get second scrn
LONG IF gdHndl& '2nd device exists?
pGwT;8 = [gdHndl&]+_gdRect 'copy it's rect
XELSE 'otherwise
pGwT;8 = @gScrnT 'copy main screen rect
END IF 'end of valid device hndl
END IF 'end of not main scrn
END IF 'end of not a max plus
FN pGinsetWnd(@pGwT,pGwKind,@pGwT) 'inset wnd as per window kind
END IF 'done
LONG IF pGwAttrs AND _openBigMask '€€ Full/Largest €€€€€€€€€€€€€
LONG IF SYSTEM(3) 'mac plus (no device drvr)
pGwT;8 = @gScrnT 'just copy the main scrn
XELSE 'otherwise
pGwB = pGwT 'any rect is larger than this
gdHndl& = FN GETDEVICELIST 'handle to 1st device in list
DO 'we'll run thru all devices
LONG IF gdHndl& 'good handle
t;8 = [gdHndl&]+_gdRect 'grab it's rect
LONG IF ((b-t)*(r-l)) > ((pGwB-pGwT)*(pGwR-pGwL))
pGwT;8 = @t 'larger area - use this one
END IF '
END IF '
gdHndl& = FN GETNEXTDEVICE(gdHndl&) 'next graphic device in list
UNTIL gdHndl& = 0 'till there are no more
END IF 'dun
FN pGinsetWnd(@pGwT,pGwKind,@pGwT) 'allow for title/borders
END IF '
LONG IF pGwAttrs AND _openCntrMask '€€ Center €€€€€€€€€€€€€€€€€€€
CALL OFFSETRECT(pGwT,-pGwL,-pGwT) 'Basic centers if zero offset
END IF '
LONG IF pGwAttrs AND _openPrevMask '€€ Previous €€€€€€€€€€€€€€€€€
LONG IF FN PTINRGN(pGwB,[_grayrgn])=_false'bot/right isn't visible?
wd = gScrnR-gScrnL 'width of main screen
ht = gScrnB-gScrnT 'height of main
LONG IF pGwR - pGwL > wd 'width won't fit?
pGwR = gScrnR:pGwL = gScrnL 'copy main screen rect
t;8 = @pGwT 'store old for restore of ht
FN pGinsetWnd(@pGwT,pGwKind,@pGwT) 'adjust for title & borders
pGwT = t:pGwB = b 'repair height to orig
END IF 'should be in position now
LONG IF pGwB - pGwT > ht 'height won't fit?
pGwT = gScrnT:pGwB = gScrnB 'copy main screen rect
t;8 = @pGwT 'store old for restore of wd
FN pGinsetWnd(@pGwT,pGwKind,@pGwT) 'adjust for title & borders
pGwR = r:pGwL = l 'repair width
END IF 'should be in position now
IF pGwB > gScrnB THEN CALL OFFSETRECT(pGwT,0,gScrnB-pGwB)
IF pGwR > gScrnR THEN CALL OFFSETRECT(pGwT,gScrnR-pGwR,0)
END IF 'end of bot/right invisible
END IF
LONG IF gWhichClass <> wndRefNum '€€ Build Class €€€€€€€€€€€€€€
LONG IF pGwT OR pGwL 'not centered
chkWnd = 64 'checking all windows
WHILE chkWnd 'until we hit zero
GET WINDOW chkWnd,wPtr& 'get this window
LONG IF wPtr& 'got a pointer?
CALL SETPORT(wPtr&) 'make it the current port
` MOVE.L #0,^t ;set point to 0,0
CALL LOCALTOGLOBAL(t) 'switch to global coords
LONG IF pGwT = t OR pGwL = l 'matches slot we want?
CALL OFFSETRECT(pGwT,4,4) 'offset to next position
chkWnd = 64 'restart at top of wnd list
END IF 'end of matched point
END IF 'end of valid wnd ptr
DEC(chkWnd) 'next (lower) window
WEND 'until checked wnd = 0
END IF
END IF '€€ Invisible €€€€€€€€€€€€€€€€
LONG IF (pGwAttrs AND _openInvisMask) OR (pGwAttrs AND _openBehindMask)
wndRefNum = -wndRefNum 'open behind others
END IF
LONG IF SYSTEM(8) < 700 'pre System 7.0
IF pGwKind = 6 THEN pGwKind = 2 'don't allow window type 6
IF pGwKind = -6 THEN pGwKind = -2 'not even modals
END IF
WINDOW wndRefNum,wTitle$,@pGwT,pGwKind,gWhichClass
CALL SETRECT(t,-9999,-9999,9999,9999)
CALL CLIPRECT(t) '€€ 03/30/93 €€
FN pGblackAndWhite:CALL ERASERECT(t)
LONG IF pGwHMax 'window scroll bars
SCROLL BUTTON 8000,1,1,pGwHMax,pGwHpg,,2 'horiz scroll bar
END IF
ref = 0
LONG IF pGwVMax
LONG IF pGwAttrs AND 128
FN pGdrawControls 'draw the field in advance
SCROLL BUTTON -8001,0,0,0,0,,1 'vert scroll bar
ref = -8001 'use negative to hook in scroll
CALL VALIDRECT(t)
FN pGfixEditor
XELSE
ref = 8001 'otherwise-standard V scroll
SCROLL BUTTON ref,1,1,pGwVMax,pGwVpg,,1'vert scroll bar
END IF
END IF
IF ref <> -8001 THEN FN pGdrawControls 'ctrls for pg Wnds
LONG IF pGwAttrs AND _openInvisMask 'was in back
LONG IF pGwRefCon& <> _"NVIS" 'user didn't specify invisible
WINDOW -wndRefNum 'bring to front
END IF
END IF '
LONG IF pGwAttrs AND _openBehindMask 'was in back
LONG IF pGwRefCon& <> _"NVIS" 'user didn't specify invisible
WINDOW OUTPUT wndRefNum 'activate w/o bringing fwd
END IF
END IF
LONG IF pGwAttrs AND 128 'splash bit set
LONG IF pGwVMax = 0 'not a Text Editor
FN pGupdate 'don't wait for update event
ticks& = FN TICKCOUNT + 140:flag =_false'calc time out:clear flag
DO 'loop till button,key or ticks
IF FN BUTTON OR LEN(INKEY$) THEN flag = _zTrue
LONG IF FN TICKCOUNT>ticks& 'sufficient number of ticks?
LONG IF gWhichClass = wndRefNum 'window num was not negative?
flag = _zTrue 'time expired - exit
END IF '
END IF '
UNTIL flag '
% EVENT,0:FLUSHEVENTS 'clear the event from the que
WINDOW CLOSE ABS(wndRefNum) 'close this feller
END IF
END IF
END IF
END IF
"PG:Build Complete"
FN pGcalcWndGlobals
LONG IF gOutWindow
CALL GETWTITLE(WINDOW(_wndPointer),gWindowTitle$)
XELSE
gWindowTitle$ = "" 'clear related globals
END IF
END FN
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ RUNTIME FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
'_______________________________________________________________________________
LOCAL FN pGmouse '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
clickedObj = FN pGpointInObj
LONG IF clickedObj
FN pGgetObj(gWhichClass,clickedObj)
LONG IF gObjKind = _buttonObj
LONG IF gObjZType = 0
gSubAction = _otherUserClick 'tell user item was clicked
gWhichObjElem = clickedObj
GLOBALS GOSUB "PG:Any Other"
END IF
END IF
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGcursor '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
LONG IF WINDOW(_outputWnd) = DIALOG(_cursEvent)'correct window?
SELECT gWhichButton 'same as gWhichField
CASE <0: 'show IBeam cursor
TEHndl& = TEHANDLE(ABS(gWhichButton)) 'if T=B then it's a pict
LONG IF {[TEHndl&]+_TEViewRect} = {[TEHndl&]+_TEViewRect.bottom}
CURSOR _pictCursor 'over a pict field
XELSE
CURSOR _iBeamCursor 'over a text field
END IF
CASE >0:CURSOR _buttonCursor 'use hand cursor
CASE ELSE:CURSOR _arrowCursor
END SELECT
XELSE 'not in active window
CURSOR _arrowCursor 'back to arrow
END IF '
END FN
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ MENU FUNCTIONS €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
'_______________________________________________________________________________
LOCAL FN pGfindMenu(theTitle$) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
theMenu = 0
mCount = FN COUNTRESOURCES(_"MENU")
FOR thisMenu = 1 TO mCount
mHndl& = FN GETINDRESOURCE(_"MENU",thisMenu)
LONG IF mHndl&
LONG IF FN HOMERESFILE(mHndl&) = SYSTEM(_aplRes)
test$ = PSTR$([mHndl&] + _menuData)
LONG IF test$ = theTitle$
theMenu = {[mHndl&]}
thisMenu = mCount
END IF
END IF
END IF
NEXT
END FN = theMenu
'_______________________________________________________________________________
LOCAL FN pGfield(xLook,yLook) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM srcT,srcL,srcB,srcR,destT;8
found = _false
srcT;8 = [TEHANDLE(gWhichField)]+_TEViewRect
objCount = FN pGcountObj(gWhichClass)
DO
CALL OFFSETRECT(srcT,xLook,yLook)
x = FN SECTRECT(srcT,#WINDOW(_wndPointer)+_portRect,destT)
LONG IF FN EQUALRECT(srcT,destT) = _false
found = _zTrue
XELSE
FOR loop = 1 TO objCount
FN pGgetObj(gWhichClass,loop)
LONG IF gObjKind = _styleObj
LONG IF gObjRef <> gWhichField
LONG IF ((gObjZType-1) AND &X1100)=0 'not a static or gray field
LONG IF FN SECTRECT(srcT,gObjT,destT)
found = _zTrue
EDIT FIELD ABS(gObjRef)
END IF
END IF
END IF
END IF
NEXT
END IF
UNTIL found
END FN
'_______________________________________________________________________________
LOCAL FN pGtab(shiftDown) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
objCount = FN pGcountObj(gWhichClass) 'object count for this wnd
LONG IF objCount 'non zero?
dfltFld = 0 'default:nothing found
grabNext = _false 'don't record yet
LONG IF shiftDown 'shift tab works in reverse
finish = 1:start = objCount 'so run the loop backwards
theStep =-1 'and step backwards
XELSE 'otherwise
start = 1:finish = objCount 'run loop forward thru list
theStep = 1 'step is normal
END IF
FOR loop = start TO finish STEP theStep 'loop thru all objs
FN pGgetObj(gWhichClass,loop) 'get the next one
LONG IF gObjKind = _styleObj 'a styled text field?
LONG IF ((gObjZType-1) AND &X1100)=0 'not a static or gray field
LONG IF dfltFld = 0 'default set yet?
dfltFld = gObjRef 'no first item = wrap around
END IF
LONG IF grabNext 'flag set to grab next?
dfltFld = gObjRef 'yep-this is the field
loop = finish 'shortcut the loop
END IF
LONG IF gObjRef = gWhichField 'this is the current field?
grabNext = _zTrue 'yep-grab next one encountered
END IF
END IF 'end of non-static field
END IF 'end of styled text field
NEXT loop
LONG IF dfltFld 'if we got one…
EDIT FIELD dfltFld ' set it
LONG IF WINDOW(_selStart) = WINDOW(_EFTextLen)
LONG IF WINDOW(_EFnum) < 8000
SETSELECT 0,WINDOW(_EFTextLen)
END IF
END IF
END IF
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGgetItemName$(menuID,itemID) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
mHndl& = FN GETMHANDLE(menuID)
LONG IF mHndl&
CALL GETITEM(mHndl&,itemID,theName$)
XELSE
theName$ = ""
END IF
END FN = theName$
'_______________________________________________________________________________
LOCAL FN pGcheckName(theMenu,theName$) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
mHndl& = FN GETMHANDLE(theMenu) 'handle to this menu
LONG IF mHndl& 'valid handle?
itemCount = FN COUNTMITEMS(mHndl&) 'number of items in menu
FOR loop = 1 TO itemCount 'loop thru items
CALL GETITEM(mHndl&,loop,t$) 'get name of item
LONG IF t$ = theName$ 'match?
DEF CHECKONEITEM(theMenu,loop)
loop = itemCount 'skip the rest of the loop
END IF
NEXT
END IF
END FN
'_______________________________________________________________________________
CLEAR LOCAL 'must clear pBlock
LOCAL FN pGopenFile '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
gFileName$ = FILES$(1,gOpenType$,,gFileVol) 'standard files dialog
LONG IF PEEK(@gFileName$) 'name <>""?
gSubAction = _mainOpen 'set up message
pBlk& = @paramBlk$ 'param Block to get file info
& pBlk& + _ioFDirIndex,0 'clear to indicate op
& pBlk& + _ioNamePtr,@gFileName$ 'set up pointer to file name
% pBlk& + _ioVRefNum,gFileVol 'set up vol number
OSErr = FN GETFILEINFO(pBlk&) 'get finder info on this file
gFileType& = [pBlk& + _ioBuffer] 'get file type
fdFlags = {pBlk& + _ioBuffer_fdflags} 'get finder flags
gIsStationery = ((fdFlags AND 2048)<>0) 'check stationery bit
GLOBALS GOSUB "PG:Any Main" 'send it to program
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGsaveAs '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
LONG IF LEN(gSaveName$) 'file name exists?
t$ = gSaveName$ 'use it
XELSE 'otherwise
t$ = "Untitled Document" 'use a default name
END IF
t$ = FILES$(0,"Save document as…",t$,vol) 'standard files
LONG IF LEN(t$) 'SF wasn't canceled?
gSaveName$ = t$ 'file name into global
gSaveVol = vol 'vol ref into global
boolean = _zTrue 'success-set flag
XELSE 'save was canceled
boolean = _false 'failure-clear flag
END IF
END FN = boolean
'_______________________________________________________________________________
LOCAL FN pGautoMenu(menuID,itemID) '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
mHndl& = FN GETMHANDLE(menuID)
LONG IF mHndl&
theTitle$ = PSTR$([mHndl&] + _menuData)
CALL GETITEM(mHndl&,itemID,theItem$)
LONG IF theTitle$ = STR#(_baseID - 2,1) '== FILE MENU ==
t$ = STR#(_baseID - 2,2) 'special allowances for open
l = LEN(t$) 'addn'l chars added by
LONG IF l
IF LEFT$(theItem$,l) = t$ THEN theItem$ = t$' Boomerang
END IF
SELECT theItem$
CASE STR#(_baseID - 2,2) '"Open" item
FN pGopenFile
CASE STR#(_baseID - 2,4) '"Page Setup…" item
DEF PAGE
CASE STR#(_baseID - 2,5) '"Close" item
LONG IF WINDOW(_activeWnd)
gDialogValue = WINDOW(_activeWnd)
GLOBALS GOSUB"PG:WCls"
END IF
CASE STR#(_baseID - 2,6) '"Quit" item
GLOBALS GOSUB"PG:Break"
CASE STR#(_baseID - 2,3) '"Save" item
boolean = _zTrue
LONG IF LEN(gSaveName$) = 0 OR gSaveVol = 0
boolean = FN pGsaveAs
END IF
LONG IF boolean
gSubAction = _mainSave
gDirty = _false
GLOBALS GOSUB"PG:Any Main"
END IF
CASE STR#(_baseID - 2,7) '"Save As…" item
boolean = FN pGsaveAs
LONG IF boolean
gSubAction = _mainSave
gDirty = _false
GLOBALS GOSUB"PG:Any Main"
END IF
END SELECT
END IF
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGfixMenus '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
IF FN BUTTON THEN CURSOR _arrowCursor
t$ = STR#(_baseID - 2,1) 'get name of File menu
LONG IF LEN(t$)
fileMenu = FN pGfindMenu(t$)
LONG IF fileMenu
mHndl& = FN GETMHANDLE(fileMenu)
LONG IF mHndl&
saveName$ = STR#(_baseID - 2,3) 'name of Save item
saveAsName$ = STR#(_baseID - 2,7) 'name of Save As… item
printItem$ = STR#(_baseID - 2,8) 'name of print item
itemCount = FN COUNTMITEMS(mHndl&)
FOR loop = 1 TO itemCount
CALL GETITEM(mHndl&,loop,t$)
SELECT t$
CASE saveName$
MENU fileMenu,loop,ABS(gDirty<>0) 'enable if dirty
IF WINDOW(_activeWnd) = 0 THEN MENU fileMenu,loop,0
CASE saveAsName$
MENU fileMenu,loop,ABS(LEN(gSaveName$)>0)'enable if file open
IF WINDOW(_activeWnd) = 0 THEN MENU fileMenu,loop,0
CASE printName$
MENU fileMenu,loop,ABS(WINDOW(_activeWnd)<>0)
END SELECT
NEXT
END IF
END IF
END IF
END FN
'_______________________________________________________________________________
LOCAL FN pGopenDoc '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
fileIndex = {[gFileList&]+2}
% [gFileList&]+2,fileIndex - 1
offSet = 4
LONG IF fileIndex > 1
FOR loop = 1 TO fileIndex - 1
offSet = offSet + 8
lgth = PEEK([gFileList&]+offSet) + 1
lgth = (lgth + 1) AND &FE
offSet=offSet+lgth
NEXT
END IF
gSubAction = {[gFileList&]} + 2 '_mainOpen or _mainPrint
gFileVol = {[gFileList&]+offSet}
gFileType& = [[gFileList&]+offSet+2]
gFileName$ = PSTR$([gFileList&]+offSet+8)
IF fileIndex = 1 THEN DEF DISPOSEH(gFileList&)
GLOBALS GOSUB "PG:Any Main"
END FN
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ RUNTIME INIT €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
'_______________________________________________________________________________
LOCAL FN pGinitRuntime '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
gEventPtr& = EVENT 'event rec never moves
IF SYSTEM(8) > 599 THEN & EVENT-8,1 'WNE 60 times/sec(Sys.6.0 & up)
gResRef = SYSTEM(4) 'current resource reference
gScrnR = SYSTEM(6) 'screen width
gScrnB = SYSTEM(7) 'screen height
gScrnT = {_mBarHeight} 'allow for menu bar
gScreenDepth = SYSTEM(11) 'max colors
CALL SETRECT(gBigT,-9999,-9999,9999,9999) 'generic big rect
curRes = FN CURRESFILE 'record curres file
CALL USERESFILE(gResRef) 'switch to app's file
theCount = FN COUNT1RESOURCES(_"MENU") 'how many menus?
WHILE theCount 'more to go?
resHndl& = FN GET1INDRESOURCE(_"MENU",theCount)'get next menu
LONG IF resHndl& 'valid handle?
menuID = {[resHndl&]} 'get its ID
LONG IF menuID > 74 AND menuID < 100 '74> Sub menus <100
MENU menuID,-2,1 'insert it
END IF
END IF
DEC(theCount) 'decrement index
WEND
CALL USERESFILE(curRes)
LONG IF SYSTEM(8) > 699 'System 7.0 or later
LONG IF FN GESTALT(_gestaltAppleEventsAttr) AND SYSERROR = 0
OSErr = FN AEINSTALLEVENTHANDLER(_typeAppleEvent,_kAEOpenApplication,LINE"PG:AE Open App",0,_false)
OSErr = FN AEINSTALLEVENTHANDLER(_typeAppleEvent,_kAEOpenDocuments ,LINE"PG:AE Open Doc",0,_false)
OSErr = FN AEINSTALLEVENTHANDLER(_typeAppleEvent,_kAEPrintDocuments ,LINE"PG:AE Print Doc",0,_false)
OSErr = FN AEINSTALLEVENTHANDLER(_typeAppleEvent,_kAEQuitApplication,LINE"PG:AE Quit App",0,_false)
END IF
END IF
LONG IF [_appParmHandle]
LONG IF {[[_appParmHandle]]+2}
LONG IF SYSTEM(_aplFlag)
gFileList& = FN HANDTOHAND([_appParmHandle])
END IF
END IF
END IF
DIM pGwT,pGwL,pGwB,pGwR,pGwKind,pGwAttrs,pGwMinX,pGwMinY
DIM pGwMaxX,pGwMaxY,pGZmT,pGZmL,pGZmB,pGZmR
DIM pGwHpg,pGwHMax,pGwVpg,pGwVMax,pGwRefCon&
theCount = FN COUNTRESOURCES(_"pG3w") 'look for splash windows
FOR loop = 1 TO theCount
resHndl& = FN GETINDRESOURCE(_"pG3w",loop)
LONG IF resHndl&
BLOCKMOVE [resHndl&],@pGwT,FN GETHANDLESIZE(resHndl&)
LONG IF pGwVMax = 0
LONG IF pGwAttrs AND 128
CALL GETRESINFO(resHndl&,ID,tp&,t$)
FN pGbuild(ID)
loop = theCount
END IF
END IF
END IF
NEXT
GLBLask& = @FN pGask$ :GLBLautoMenu& = @FN pGautoMenu
GLBLBlkNWhite& = @FN pGblackAndWhite :GLBLbtnAction& = @FN pGbtnAction
GLBLbuild& = @FN pGbuild :GLBLcheckName& = @FN pGcheckName
GLBLclose& = @FN pGclose :GLBLcloseAll& = @FN pGcloseAll
GLBLcntrRes& = @FN pGcntrRes :GLBLcountObj& = @FN pGcountObj
GLBLcursor& = @FN pGcursor :GLBLdrwCtrls& = @FN pGdrawControls
GLBLfield& = @FN pGfield :GLBLfindMenu& = @FN pGfindMenu
GLBLfixEditor& = @FN pGfixEditor :GLBLfixMenus& = @FN pGfixMenus
GLBLframeBtn& = @FN pGframeBtn :GLBLgetGroup& = @FN pGgetGroup
GLBLgetIName& = @FN pGgetItemName$ :GLBLgetObj& = @FN pGgetObj
GLBLgetRef& = @FN pGgetRef :GLBLgetText& = @FN pGgetText$
GLBLgetWnd& = @FN pGgetWnd$ :GLBLgetWTitle& = @FN pGgetWTitle
GLBLinitRntm& = @FN pGinitRuntime :GLBLinsetWnd& = @FN pGinsetWnd
GLBLmouse& = @FN pGmouse :GLBLopenDoc& = @FN pGopenDoc
GLBLopenFile& = @FN pGopenFile :GLBLptInObj& = @FN pGpointInObj
GLBLputObj& = @FN pGputObj :GLBLputWnd& = @FN pGputWnd
GLBLrepRes& = @FN pGreplaceRes :GLBLrepXRes& = @FN pGreplaceXRes
GLBLsaveAs& = @FN pGsaveAs :GLBLsetGroup& = @FN pGsetGroup
GLBLsetGrow& = @FN pGsetGrow :GLBLsetZoom& = @FN pGsetZoom
GLBLshowErr& = @FN pGshowErr :GLBLtab& = @FN pGtab
GLBLupdate& = @FN pGupdate :GLBLuseObjClr& = @FN pGuseObjColor
GLBLpntDpth& = @FN pGdepthOfPoint
END FN
'_______________________________________________________________________________
CLEAR LOCAL 'must clear pBlk & noName$
LOCAL FN pGAEDocList '›fi› 01/15/92 ›fi›
'—————————————————————————————————————————————————————————————————————————————
DIM AEDesc&;0,descriptorType&,dataHandle&
DIM fsSpec;0,fsVRefNum,fsParID&,63 fsName$
maxSize& = @maxSize& - @fsSpec
LONG IF FN AEGETPARAMDESC(gEventPtr&,_keyDirectObject,_typeAEList,AEDesc&)= 0
LONG IF FN AECOUNTITEMS(AEDesc&,theCount&) = 0
FOR loop = 1 TO theCount&
LONG IF FN AEGETNTHPTR(AEDesc&,loop,_typeFSS,keyWord&,rtnType&,@fsSpec,maxSize&,actualSize&) = 0
gFileName$ = fsName$ 'record name from FS rec
pBlk& = @paramBlk$ 'chg WrkDirID to vRefNum
% pBlk& + _ioVRefNum ,fsVRefNum 'volume ref num
& pBlk& + _ioWDDirID ,fsParID& 'set par ID in pblock
OSErr = FN OPENWD(pBlk&) 'open this path
gFileVol = {pBlk& + _ioVRefNum} 'get volRef num
& pBlk& + _ioFDirIndex,0 'clear dir index to indicate op
& pBlk& + _ioNamePtr,@fsName$ 'set up pointer to file name
OSErr = FN GETFILEINFO(pBlk&) 'get finder info on this file
gFileType& = [pBlk& + _ioBuffer] 'get file type
fdFlags = {pBlk& + _ioBuffer_fdflags}'get finder flags
gIsStationery = ((fdFlags AND 2048)<>0)'check stationery bit
GLOBALS GOSUB "PG:Any Main"
END IF
DEF BLOCKFILL(pBlk&,250,0) ' ∑∑ 8/13/93 ∑∑
NEXT
END IF
OSErr = FN AEDISPOSEDESC(AEDesc&)
END IF
END FN
'_______________________________________________________________________________
"PG:AE Open App" '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'———————————————————————————————————————————————————————————————————————————————
ENTERPROC(gEventPtr&,gEventPtr&,gWhichRefCon&)
: 'do nothing
gMessage1 = 0
EXITPROC = gMessage1
RETURN
'_______________________________________________________________________________
"PG:AE Quit App" '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'———————————————————————————————————————————————————————————————————————————————
ENTERPROC(gEventPtr&,gEventPtr&,gWhichRefCon&)
GLOBALS GOSUB "PG:Break"
gMessage1 = 0
EXITPROC = gMessage1
RETURN
'_______________________________________________________________________________
"PG:AE Print Doc" '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'———————————————————————————————————————————————————————————————————————————————
ENTERPROC(gEventPtr&,gEventPtr&,gWhichRefCon&)
gSubAction = _mainPrint
FN pGAEDocList
gMessage1 = 0
EXITPROC = gMessage1
RETURN
'_______________________________________________________________________________
"PG:AE Open Doc" '∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'———————————————————————————————————————————————————————————————————————————————
ENTERPROC(gEventPtr&,gEventPtr&,gWhichRefCon&)
gSubAction = _mainOpen
FN pGAEDocList
gMessage1 = 0
EXITPROC = gMessage1
RETURN
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ RUNTIME PACKAGE €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
"PG:Start"
FN pGinitRuntime 'handle my startup
ON BREAK GOSUB "PG:Chk Break" 'go here for command-period
ON DIALOG GOSUB "PG:Dialog" 'use this routine for dialog
ON EDIT GOSUB "PG:TEKey" 'filter keys for edit flds
ON EVENT GOSUB "PG:Event" 'pre-event filter
ON MENU GOSUB "PG:Menu" 'menu handlers
ON MOUSE GOSUB "PG:Mouse" 'mouse handler
ON TIMER(-10) GOSUB "PG:Timer" 'ZTimer (30 ticks=1/2 second)
ON STOP GOSUB "PG:Stop"
'-------------------------------------------------------------------------------
gSubAction =_mainStart 'let user init
GOSUB "PG:Any Main"
'-------------------------------------------------------------------------------
DO
MENU ON : DIALOG ON : BREAK ON : MOUSE ON : TIMER ON : EVENT ON
MENU OFF : DIALOG OFF : BREAK OFF : MOUSE OFF : TIMER OFF : EVENT OFF
IF gKissOfDeath THEN GOSUB"PG:Break"
UNTIL 0
'-------------------------------------------------------------------------------
"PG:Menu"
'-------------------------------------------------------------------------------
gAction = _MenuAction 'action constant
gWhichMenu = MENU(_menuID) 'selected menu
gWhichItem = MENU(_itemID) 'selected item
gItemName$ = FN pGgetItemName$(gWhichMenu,gWhichItem)'get name of this item
GOSUB "PG:Send Event" 'send event to user
MENU 'unhilite the menu
IF gAction THEN FN pGautoMenu(gWhichMenu,gWhichItem)
RETURN 'done
'-------------------------------------------------------------------------------
"PG:Dialog"
'-------------------------------------------------------------------------------
gWhichDialog = DIALOG(0) 'dialog action
gDialogValue = DIALOG(gWhichDialog) 'dialog reference
ON gWhichDialog GOTO "PG:Btn" ,"PG:EAct","PG:WClk","PG:WCls" ,"PG:WUpd"
ON gWhichDialog - 5 GOTO "PG:ERet","PG:ETab","PG:NOP" ,"PG:NOP" ,"PG:EStb"
ON gWhichDialog - 10 GOTO "PG:EClr","PG:ELft","PG:ERt" ,"PG:EUp" ,"PG:EDn"
ON gWhichDialog - 15 GOTO "PG:Key" ,"PG:Dsk" ,"PG:WAct","PG:MFevt","PG:Gcrs"
ON gWhichDialog - 20 GOTO "PG:Crsr","PG:Abt" ,"PG:Usr"
RETURN
'===============================================================================
"PG:Btn" '(1) Button clicked
gAction = _buttonAction 'action constant
gWhichButton = gDialogValue 'clicked button
gWhichClass = WINDOW(_outputWClass)
FN pGbtnAction(gWhichButton)
gWhichObjElem= FN pGgetRef(gWhichClass,gWhichButton)'get btn's obj record
gButtonValue = BUTTON(gWhichButton) 'current btn value
gControlHndl&= BUTTON&(gWhichButton) 'get control's handle
LONG IF (FN GETCREFCON(gControlHndl&)>>29) = 4 'ZBasic scroll bar?
gControlTitle$ = STR#(_baseID-5,4) 'send "Scroll Button" as title
XELSE 'not a scroll bar?
CALL GETCTITLE(gControlHndl&,gControlTitle$) 'send control's title
END IF
GOTO "PG:Send Event"
RETURN
'===============================================================================
"PG:WClk" '(5) Inactive Window Clicked
gSubAction = _windowClicked 'sub action:click in inactive
gWhichWindow = gDialogValue 'window clicked
GOSUB "PG:Any Window" 'send wnd msg(sets action _con)
LONG IF gAction 'not handled by user?
IF gWhichWindow THEN WINDOW gWhichWindow 'I'll do the switch
END IF
RETURN
'-------------------------------------------------------------------------------
"PG:WCls" '(4) Click in close box
gSubAction = _windowClose 'subaction constant
gWhichWindow = gDialogValue
GOSUB "PG:Any Window" 'send wnd msg(sets action _con)
LONG IF gAction 'not handled by user?
FN pGcloseWindow(gWhichWindow) 'I'll close it
END IF
RETURN
'-------------------------------------------------------------------------------
"PG:WAct" '(18) activate/deactivate
gWhichWindow = ABS(gDialogValue)
LONG IF gDialogValue > 0
gSubAction =_windowActivate ' positive = activate
XELSE ' negative = deactivate
gSubAction =_windowDeactivate
END IF
GOTO "PG:Any Window" 'send wnd msg(sets action _con)
RETURN
'-------------------------------------------------------------------------------
"PG:WUpd" '(5) update
gWhichWindow = gDialogValue
gSubAction = _windowUpdate
gOutputWas = WINDOW(_outputWnd)
WINDOW OUTPUT gWhichWindow
GOSUB "PG:Any Window"
IF gAction THEN FN pGupdate
IF gOutputWas THEN WINDOW OUTPUT gOutputWas
RETURN
'-------------------------------------------------------------------------------
"PG:NOP" 'No Operation
RETURN
'===============================================================================
"PG:EAct" '(2) Edit/Pict field Clicked
gSubAction = _fieldActivate
gFieldWas = WINDOW(_lastEFnum)
GOTO "PG:Any Field"
RETURN
'-------------------------------------------------------------------------------
"PG:ERet" '(6) Return key in field
gSubAction = _fieldReturn
GOTO "PG:Any Field"
RETURN
'-------------------------------------------------------------------------------
"PG:ETab" '(7) Tab Key pressed
gSubAction = _fieldTab
GOSUB "PG:Any Field"
IF gAction THEN FN pGtab(_false)
RETURN
'-------------------------------------------------------------------------------
"PG:EStb" '(10) shift tab pressed
gSubAction = _fieldShiftTab
GOSUB "PG:Any Field"
IF gAction THEN FN pGtab(_zTrue)
RETURN
'-------------------------------------------------------------------------------
"PG:EClr" '(11) clear key pressed
gSubAction = _fieldClear
GOSUB "PG:Any Field"
IF gAction THEN EDIT FIELD gObjRef,""
RETURN
'-------------------------------------------------------------------------------
"PG:ELft" '(12) left arrow pressed
gSubAction = _fieldLeft
GOSUB "PG:Any Field"
IF gAction THEN FN pGfield(-10,0)
RETURN
'-------------------------------------------------------------------------------
"PG:ERt" '(13) right arrow pressed
gSubAction = _fieldRight
GOSUB "PG:Any Field"
IF gAction THEN FN pGfield(10,0)
RETURN
'-------------------------------------------------------------------------------
"PG:EUp" '(14) up arrow pressed
gSubAction = _fieldUp
GOSUB "PG:Any Field"
IF gAction THEN FN pGfield(0,-10)
RETURN
'-------------------------------------------------------------------------------
"PG:EDn" '(15) down arrow pressed
gSubAction = _fieldDown
GOSUB "PG:Any Field"
IF gAction THEN FN pGfield(0,10)
RETURN
'-------------------------------------------------------------------------------
"PG:Any Field" 'branch sets action constant
gAction = _fieldAction
gWhichField = gDialogValue
gWhichObjElem = FN pGgetRef(WINDOW(_outputWClass),gWhichField)'get field's obj record
FN pGgetObj(WINDOW(_outputWClass),gWhichObjElem)
GOTO "PG:Send Event"
RETURN
'===============================================================================
"PG:Key" '(16) Key Presed Not in Field
gKey$ = CHR$(gDialogValue)
gSubAction = _otherKeyPressed
GOTO "PG:Any Other"
RETURN
'-------------------------------------------------------------------------------
"PG:Dsk" '(17) Disk Inserted
gSubAction = _otherDisk
GOSUB "PG:Any Other"
IF gAction THEN FN pGopenFile
RETURN
'-------------------------------------------------------------------------------
"PG:MFevt" '(19) MultiFinder Event
SELECT gDialogValue
CASE _MFResume 'resume
gSubAction = _otherSwitch
gInBackground = _false
FLUSHEVENTS
CASE _MFSuspend 'suspend
gSubAction = _otherSwitch
gInBackground = _zTrue
CASE _MFClipboard 'convert scrap
gSubAction = _otherScrap
gInBackground = _false
CASE _MFMouse 'mouse moved from MF region
gSubAction = _otherCursor
END SELECT
GOTO "PG:Any Other"
RETURN
'-------------------------------------------------------------------------------
"PG:Gcrs" '(20) New Global Mouse Position
gSubAction = _otherCursor
GOSUB "PG:Any Other" 'send to user
LONG IF gAction 'not handled?
CURSOR _arrowCursor 'back to arrow
END IF
RETURN
'-------------------------------------------------------------------------------
"PG:Crsr" '(21) New Cursor Pos in Window
gWhichButton = gDialogValue
gSubAction = _otherCursor
GOSUB "PG:Any Other" 'send to user
LONG IF gAction 'not handled?
FN pGcursor
END IF
RETURN
'-------------------------------------------------------------------------------
"PG:Abt" '(22) About to ???
SELECT CASE gDialogValue
CASE _premenuclick 'mouse in bar or cmnd key
FN pGfixMenus
gSubAction = _otherBeforeMenu
GOSUB "PG:Any Other" 'send to user
CASE _preWndGrow 'mouse in grow box
gSubAction = _WindowWillGrow
gWhichWindow = WINDOW(_activeWnd)
GOSUB "PG:Any Window"
LONG IF gAction
FN pGsetGrow
END IF
CASE _wndMoved 'already did a drag
gSubAction = _windowMoved
gWhichWindow = WINDOW(_activeWnd)
GOSUB "PG:Any Window"
CASE _wndSized 'after grow
gWhichWindow = WINDOW(_activeWnd)
gSubAction = _windowSized
GOSUB "PG:Any Window"
LONG IF gAction
FN pGfixEditor
END IF
CASE 5 'field about to change
gSubAction = _fieldChanging
gDialogValue = WINDOW(_EFnum)
GOSUB "PG:Any Field"
CASE 6 'field clicked
gSubAction = _fieldClicked
gDialogValue = WINDOW(_EFnum)
GOSUB "PG:Any Field"
CASE _preWndZoomIn 'about to zoom in
gSubAction = _windowWillZoomIn
gWhichWindow = WINDOW(_activeWnd)
GOSUB "PG:Any Window"
CASE _preWndZoomOut 'about to zoom out
gSubAction = _windowWillZoomOut
gWhichWindow = WINDOW(_activeWnd)
GOSUB "PG:Any Window"
IF gAction THEN FN pGsetZoom
CASE _wndDocWillMove 'background window will move
gSubAction = _windowDocWillMove
gWhichWindow = WINDOW(_outputWnd)
GOSUB "PG:Any Window"
END SELECT
RETURN
'-------------------------------------------------------------------------------
"PG:Usr" '(23) User Posted Event
LONG IF gDialogValue < 0
FN pGshowErr(EVENT%) 'field or other error
RETURN
XELSE
gSubAction = _otherUser
GOTO "PG:Any Other"
END IF
'===============================================================================
"PG:Chk Break" IF _ignoreCmndPeriod THEN RETURN 'command period pressed
"PG:Break" 'called to exit
gSubAction = _mainShutDown
gKissOfDeath = _zTrue
GOSUB "PG:Any Main" 'ask user to shutdown
LONG IF gAction 'user didn't abort close
LONG IF FN pGcloseAll 'could we close all windows
END 'we're outta here
END IF
END IF
gKissOfDeath = _false
RETURN
'===============================================================================
"PG:Stop"
DEF DISPOSEH(gFileList&)
RETURN
'===============================================================================
"PG:Mouse"
gAction = _mouseAction
gClickStatus = MOUSE(0)
gMouseX = MOUSE(1)
gMouseY = MOUSE(2)
gModifiers = EVENT%
gWhen& = EVENT&
gWhereY;4 = @gMouseY
CALL LOCALTOGLOBAL(gWhereY)
GOSUB "PG:Send Event"
IF gAction THEN FN pGmouse
RETURN
'===============================================================================
"PG:Timer"
gSubAction = _mainTimer
GOTO "PG:Any Main"
RETURN
'===============================================================================
"PG:TEKey"
gKey$ = TEKEY$
gSubAction = _fieldKeyPressed
gDialogValue = WINDOW(_EFnum)
gWhichField = gDialogValue
GOSUB "PG:Any Field"
LONG IF gAction
LONG IF gKey$ = CHR$(127)
gKey$ = CHR$(29) + CHR$(8)
END IF
TEKEY$ = gKey$
END IF
RETURN
'===============================================================================
"PG:Event"
gAction = _otherAction
gWhat;_evtBlkSize = EVENT
LONG IF {EVENT}
gSubAction = _otherFilterEvent
XELSE
LONG IF gFileList&
FN pGopenDoc:RETURN
XELSE
gSubAction = _otherNullEvent
END IF
END IF
GOSUB "PG:Main Program"
LONG IF {EVENT}=_updatEvt
LONG IF gAction > 0
gWhichClass = WINDOW(_outputWClass)
FN pGblackAndWhite
END IF
END IF
RETURN
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ MAIN €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
"PG:Any Window"
gAction = _windowAction
FN pGgetWTitle(gWhichWindow) 'get title of this window
GOTO "PG:Send Event"
'-------------------------------------------------------------------------------
"PG:Any Main"
gAction = _mainAction
GOTO "PG:Send Event"
'-------------------------------------------------------------------------------
"PG:Any Other"
gAction = _otherAction
'-------------------------------------------------------------------------------
"PG:Send Event"
FN pGcalcWndGlobals
'-------------------------------------------------------------------------------
'*******************************************************************************
"PG:Main Program"
'*******************************************************************************
